home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / packages / generic-sc.el.z / generic-sc.el
Encoding:
Text File  |  1998-05-21  |  58.1 KB  |  1,759 lines
  1. ;;; generic-sc.el --- generic interface to source control systems
  2.  
  3. ;; Copyright (C) 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
  4.  
  5. ;; Author: devin@lucid.com
  6. ;; Maintainer: Unmaintained
  7. ;; Keywords: tools, unix
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  23. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Synched up with: Not in FSF.
  27.  
  28. ;;; Commentary:
  29.  
  30. ;; The generic interface provide a common set of functions that can be
  31. ;; used to interface with a source control system like SCCS, RCS or
  32. ;; CVS.  
  33. ;; 
  34. ;; You chose which source control system to use by calling sc-mode
  35. ;; 
  36. ;; The module is based on the sccs.el mode of Eric S. Raymond
  37. ;; (eric@snark.thyrsus.com) which was distantly derived from an rcs
  38. ;; mode written by Ed Simpson ({decvax, seismo}!mcnc!duke!dukecdu!evs)
  39. ;; in years gone by and revised at MIT's Project Athena.
  40.  
  41. ;;; Code:
  42.  
  43. ;; This can be customized by the user
  44.  
  45. (defgroup generic-sc nil
  46.   "Generic interface to source control systems"
  47.   :prefix "sc-"
  48.   :group 'tools)
  49.  
  50.  
  51. (defcustom sc-diff-command '("diff")
  52.   "*The command/flags list to be used in constructing diff commands."
  53.   :type '(repeat string)
  54.   :group 'generic-sc)
  55.  
  56. ;; Duplicated from pcl-cvs.
  57. (defvar cvs-program "cvs"
  58.   "*The command name of the cvs program.")
  59.  
  60. (defcustom sc-mode-expert ()
  61.   "*Treat user as expert; suppress yes-no prompts on some things."
  62.   :type 'boolean
  63.   :group 'generic-sc)
  64.  
  65. (defcustom sc-max-log-size 510
  66.   "*Maximum allowable size of a source control log message."
  67.   :type 'integer
  68.   :group 'generic-sc)
  69.  
  70. (defcustom sc-ccase-comment-on '(checkout checkout-dir checkin-dir rename
  71.                        new-brtype new-branch checkin-merge
  72.                        create-label label-sources)
  73.   "*Operations on which comments would be appreciated.
  74. We check the values checkout, checkout-dir, checkin-dir,
  75. rename, new-brtype, new-branch, create-label,
  76. and label-sources as symbols."
  77.   :type '(repeat symbol)
  78.   :group 'generic-sc)
  79.  
  80. (defvar sc-ccase-reserve nil
  81.   "Whether to reserve checkouts or not. By default, this is nil - don't.
  82. Other values are t - do, and anything else, eg. 'ask - ask.")
  83.  
  84. ;; default keybindings
  85. (defvar sc-prefix-map (lookup-key global-map "\C-xv"))
  86. (if (not (keymapp sc-prefix-map))
  87.     (progn
  88.       (setq sc-prefix-map (make-sparse-keymap))
  89.       (define-key global-map "\C-xv" sc-prefix-map)
  90.       (define-key sc-prefix-map "v" 'sc-next-operation)
  91.       (define-key sc-prefix-map "=" 'sc-show-changes)
  92.       (define-key sc-prefix-map "l" 'sc-show-history)
  93.       (define-key sc-prefix-map "p" 'sc-visit-previous-revision)
  94.       (define-key sc-prefix-map "u" 'sc-revert-file)
  95.       (define-key sc-prefix-map "d" 'sc-list-registered-files)
  96.       (define-key sc-prefix-map "\C-d" 'sc-update-directory)
  97.       (define-key sc-prefix-map "\C-r" 'sc-rename-file)
  98.       ))
  99.  
  100.  
  101. ;;; The user does not change these
  102. (defvar sc-generic-name ""
  103.   "Name of the source control system used.  Is displayed in the modeline.")
  104.  
  105. (defvar sc-mode-line-string ()
  106.   "Revision number to show in the mode line")
  107.  
  108. (defvar sc-generic-log-buf ()
  109.   "Buffer for entering log message")
  110.  
  111. (defvar sc-log-entry-keymap ()
  112.   "Additional keybindings used when entering the log message")
  113.  
  114. (defvar sc-can-hack-dir ()
  115.   "Does the SC system allow users to play directly with directories")
  116.  
  117. (defvar sc-ccase-mfs-prefixes ()
  118.   "Prefixes known to the system to be MFS ... ignore all others")
  119.  
  120. (defmacro sc-chmod (perms file)
  121.   (list 'call-process "chmod" nil nil nil perms file))
  122.  
  123. (defmacro error-occurred (&rest body)
  124.   (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
  125.  
  126.  
  127. ;;; User level functions
  128. (defun sc-next-operation (verbose)
  129.   "Do the next logical source-control operation on the file in the current buffer.
  130. The current subdirectory must be under source control.
  131.    If the file is not already registered with the source control, this registers it 
  132. and checks it out.
  133.    If the file is registered and not locked by anyone, this checks it out.
  134.    If the file is registered and locked by the calling user, this pops up a
  135. buffer for creation of a log message, then checks the file in.
  136. A read-only copy of the changed file is left in place afterwards.
  137.    If the file is registered and locked by someone else, an error message is
  138. returned indicating who has locked it."
  139.   (interactive "P")
  140.   (if (not buffer-file-name)
  141.       (error "There is no file associated with buffer %s" (buffer-name)))
  142.   (let* (revision
  143.      (file buffer-file-name)
  144.      (lock-info (sc-lock-info file))
  145.      (sc-generic-log-buf
  146.       (get-buffer-create (format "*%s-Log*" sc-generic-name))))
  147.     (if (eq lock-info 'na)
  148.     (error "The file associated with buffer %s is not registered" (buffer-name)))
  149.     
  150.     ;; if file is not registered register it and set lock-info to show it's not locked
  151.     (if (not lock-info)
  152.     (progn
  153.       (sc-register-file verbose)
  154.       (setq lock-info (list () ()))))
  155.     
  156.     (cond ((not (car lock-info))
  157.        ;; if there is no lock on the file, assert one and get it
  158.        (sc-check-out file t)
  159.        (revert-buffer nil t)
  160.        (sc-mode-line))
  161.           
  162.       ((and (not (equal sc-generic-name "CCase"))
  163.            (not (equal (car lock-info) (user-login-name))))
  164.        ;; file is locked by someone else
  165.        (error "Sorry, %s has that file locked." (car lock-info)))
  166.  
  167.       (t 
  168.        ;; OK, user owns the lock on the file 
  169.        ;; if so, give user a chance to save before delta-ing.
  170.        (if (and (buffer-modified-p)
  171.             (or
  172.              sc-mode-expert
  173.              (y-or-n-p (format "%s has been modified. Write it out? "
  174.                        (buffer-name)))))
  175.            (save-buffer))
  176.            
  177.        (setq revision (car (cdr lock-info)))
  178.            
  179.        ;; user may want to set nonstandard parameters
  180.        (if verbose
  181.            (if (or sc-mode-expert
  182.                (y-or-n-p 
  183.             (format "revision: %s  Change revision level? "
  184.                 revision)))
  185.            (setq revision (read-string "New revision level: "))))
  186.            
  187.        ;; OK, let's do the delta
  188.        (let ((buffer (sc-temp-buffer)))
  189.          (if (save-window-excursion
  190.            ;; this excursion returns t if the new version was saved OK
  191.            (pop-to-buffer buffer)
  192.            (erase-buffer)
  193.            (set-buffer-modified-p nil)
  194.            (sc-log-entry-mode)
  195.            (message 
  196.             "Enter log message. Type C-c C-c when done, C-c ? for help.")
  197.            (prog1
  198.                (and (not (error-occurred (recursive-edit)))
  199.                 (not (error-occurred
  200.                   (sc-check-in file revision
  201.                            (buffer-string)))))
  202.              (setq buffer-file-name nil)
  203.              (bury-buffer buffer)))
  204.            
  205.          ;; if the save went OK do some post-checking
  206.          (if (buffer-modified-p)
  207.              (error
  208.               "Checked-in version of file does not match buffer!")
  209.            (revert-buffer nil t)
  210.            (sc-mode-line)
  211.            (run-hooks 'sc-check-in-ok))))))))
  212.  
  213. (defun sc-insert-last-log ()
  214.   "Insert the log message of the last check in at point."
  215.   (interactive)
  216.   (insert-buffer sc-generic-log-buf))
  217.  
  218. (defun sc-abort-check-in ()
  219.   "Abort a source control check-in command."
  220.   (interactive)
  221.   (if (or sc-mode-expert (y-or-n-p "Really Abort Check-in? "))
  222.       (progn
  223.     (delete-window)
  224.     (abort-recursive-edit))))
  225.  
  226. (defun sc-log-exit ()
  227.   "Proceed with checkin with the contents of the current buffer as message."
  228.   (interactive)
  229.   (if (< (buffer-size) sc-max-log-size)
  230.       (progn
  231.     (copy-to-buffer sc-generic-log-buf (point-min) (point-max))
  232.     (exit-recursive-edit)
  233.     (delete-window))
  234.     (goto-char sc-max-log-size)
  235.     (error
  236.      "Log must be less than %d characters. Point is now at char %d."
  237.      sc-max-log-size (point))))
  238.  
  239.  
  240. ;;; Functions to look at the edit history
  241. (defun sc-show-changes (arg)
  242.   "Compare the version being edited with the last checked-in revision.
  243. With a prefix argument prompt for revision to compare with."
  244.   (interactive "P")
  245.   ;; check that the file is not modified
  246.   (if (and (buffer-modified-p)
  247.        (or
  248.         sc-mode-expert
  249.         (y-or-n-p (format "%s has been modified. Write it out? "
  250.                   (buffer-name)))))
  251.       (save-buffer))
  252.   (let* ((revision (and arg (read-string "Revision to compare against: ")))
  253.      (file buffer-file-name)
  254.      (name (file-name-nondirectory file))
  255.      (old (sc-get-version-in-temp-file file revision))
  256.      (buffer (sc-temp-buffer))
  257.      status)
  258.     (save-excursion
  259.       (set-buffer buffer)
  260.       (erase-buffer)
  261.       (setq default-directory (file-name-directory file))
  262.       (setq status
  263.         (apply 'call-process (car sc-diff-command) () t ()
  264.            (append (cdr sc-diff-command) (list old) (list file)))))
  265.     (if (not (or (eq 0 status) (eq 1 status))) ; see man diff.1
  266.     (progn
  267.       (display-buffer buffer)
  268.       (error "diff FAILED")))
  269.     (delete-file old)
  270.     (save-excursion
  271.       (set-buffer buffer)
  272.       (goto-char (point-min))
  273.       (if (equal (point-min) (point-max))
  274.       (insert
  275.        (format "No changes to %s since last update."
  276.            (file-name-nondirectory file)))
  277.     (insert "==== Diffs for " file "\n")
  278.     (insert "==== ")
  279.     (mapcar '(lambda (i) (insert i " ")) sc-diff-command)
  280.     (insert name "<" (or revision "current") ">" " " name "\n\n")))
  281.     (display-buffer buffer)))
  282.  
  283. (defun sc-show-revision-changes ()
  284.   "Prompt for a revision to diff against."
  285.   (interactive)
  286.   (sc-show-changes 4))
  287.  
  288. (defun sc-version-diff-file (file rel1 rel2)
  289.   "For FILE, report diffs between two revisions REL1 and REL2 of it."
  290.   (interactive "fFile: \nsOlder version: \nsNewer version: ")
  291.   (if (string-equal rel1 "") (setq rel1 nil))
  292.   (if (string-equal rel2 "") (setq rel2 nil))
  293.   (let ((buffer (sc-temp-buffer)))
  294.     (set-buffer buffer)
  295.     (erase-buffer)
  296.     (let ((v1 (sc-get-version-in-temp-file file rel1))
  297.       (v2 (if rel2 (sc-get-version-in-temp-file file rel2) file)))
  298.       (and v1
  299.        v2
  300.        (unwind-protect
  301.            (apply 'call-process (car sc-diff-command) nil t t
  302.               (append (cdr sc-diff-command) (list v1) (list v2)))))
  303.       (condition-case () (delete-file v1) (error nil))
  304.       (if rel2
  305.       (condition-case () (delete-file v2) (error nil)))
  306.       (set-buffer-modified-p nil)
  307.       (goto-char (point-min))
  308.       (if (equal (point-min) (point-max))
  309.       (message
  310.        (format "No changes to %s between %s and %s." file rel1 rel2))
  311.     (display-buffer buffer)))))
  312.  
  313. (defun sc-show-history ()
  314.   "List the edit history of the current buffer."
  315.   (interactive)
  316.   (let ((file buffer-file-name))
  317.     (if (not file)
  318.     (error "There is no file associated with buffer %s" (buffer-name)))
  319.     (if (not (sc-lock-info file))
  320.     (error "The file is not registered in the source control system"))
  321.     (let ((buffer (sc-temp-buffer)))
  322.       (save-excursion
  323.     (set-buffer buffer)
  324.     (erase-buffer)
  325.     (sc-history file)
  326.     (goto-char (point-min)))
  327.       (display-buffer buffer))))
  328.  
  329. (defun sc-visit-previous-revision (revision)
  330.   "Show a previous revision of the current file"
  331.   (interactive "sShow previous revision number: ")
  332.   (let ((file buffer-file-name))
  333.     (if (not file)
  334.     (error "There is no file associated with buffer %s" (buffer-name)))
  335.     (let ((other-file (sc-get-version-in-temp-file file revision))
  336.       (buffer-name (concat (file-name-nondirectory file)
  337.                    "<" sc-generic-name " " revision ">")))
  338.       (pop-to-buffer (get-buffer-create buffer-name))
  339.       (erase-buffer)
  340.       (insert-file other-file)
  341.       ;; get the same major mode as the original file
  342.       (setq buffer-file-name file)
  343.       (normal-mode)
  344.       (setq buffer-file-name ())
  345.       (set-buffer-modified-p ())
  346.       (toggle-read-only)
  347.       (delete-file other-file))))
  348.  
  349. (defun sc-revert-file ()
  350.   "Revert the current buffer's file back to the last saved version."
  351.   (interactive)
  352.   (let ((file buffer-file-name))
  353.     (if (y-or-n-p (format "Revert file %s to last checked-in revision?" file))
  354.     (progn
  355.       (sc-revert file)
  356.       (revert-buffer nil t)
  357.       (sc-mode-line)))))
  358.  
  359. ;; Functions to get directory level information
  360.  
  361. (defun sc-list-all-locked-files (arg)
  362.   "List all files currently locked under the revision control system.
  363. With prefix arg list only the files locked by the user."
  364.   (interactive "P")
  365.   (let* ((locker (and arg (user-login-name)))
  366.      (buffer (sc-tree-walk 'sc-list-file-if-locked locker)))
  367.     (save-excursion
  368.       (set-buffer buffer)
  369.       (goto-char (point-min))
  370.       (if (= (point-min) (point-max))
  371.       (insert "No files locked ")
  372.     (insert "Files locked "))
  373.       (if locker
  374.       (insert "by " locker " "))
  375.       (insert "in " default-directory "\n\n"))
  376.     (display-buffer buffer)))
  377.       
  378. (defun sc-list-locked-files ()
  379.   "List all files currently locked by me"
  380.   (interactive)
  381.   (sc-list-all-locked-files 4))
  382.  
  383. (defun sc-list-registered-files ()
  384.   "List all files currently registered under the revision control system."
  385.   (interactive)
  386.   (let ((buffer (sc-tree-walk 'sc-list-file)))
  387.     (save-excursion
  388.       (set-buffer buffer)
  389.       (if (= (point-min) (point-max))
  390.       (insert "No files registered in " sc-generic-name
  391.           " in " default-directory)
  392.     (goto-char (point-min))
  393.     (insert "Files registered in " sc-generic-name " in " default-directory
  394.         "\n\n")))
  395.     (display-buffer buffer)))
  396.        
  397. (defun sc-update-directory ()
  398.   "Updates the current directory by getting the latest copies of the files"
  399.   (interactive)
  400.   (save-some-buffers)
  401.   (let ((buffer (sc-tree-walk 'sc-update-file)))
  402.     (save-excursion
  403.       (set-buffer buffer)
  404.       (goto-char (point-min))
  405.       (if (= (point-min) (point-max))
  406.       (insert "No files needed to be updated in " default-directory "\n\n")
  407.     (insert "Files updated in " default-directory "\n\n")))
  408.     (display-buffer buffer)))
  409.  
  410. ;; Miscellaneous other entry points
  411.  
  412. (defun sc-register-file (verbose)
  413.   "Register the file visited by the current buffer into source control.
  414. Prefix argument register it under an explicit revision number."
  415.   (interactive "P")
  416.   (let ((file buffer-file-name))
  417.     (if (not file)
  418.     (error "There is no file associated with buffer %s" (buffer-name)))
  419.     (let ((lock-info (sc-lock-info file))
  420.       (revision ()))
  421.       (if lock-info
  422.       (error "This file is already registered into %s" sc-generic-name))
  423.       ;; propose to save the file if it's modified
  424.       (if (and (buffer-modified-p)
  425.            (or
  426.         sc-mode-expert
  427.         (y-or-n-p (format "%s has been modified. Write it out? "
  428.                   (buffer-name)))))
  429.       (save-buffer))
  430.       ;; get the revision number
  431.       (if verbose
  432.       (setq revision (read-string "Initial Revision Number: ")))
  433.       (sc-register file revision)
  434.       (revert-buffer nil t)
  435.       (sc-mode-line))))
  436.  
  437. (defun sc-rename-file (old new)
  438.   "Rename a file, taking its source control archive with it."
  439.   (interactive "fOld name: \nFNew name: ")
  440.   (let ((owner (sc-locking-user old)))
  441.     (if (and owner (not (string-equal owner (user-login-name))))
  442.     (error "Sorry, %s has that file checked out" owner)))
  443.   (if sc-can-hack-dir
  444.       (rename-file old new t))
  445.   (sc-rename old new))
  446.  
  447. (defun sc-rename-this-file (new)
  448.   "Rename the file of the current buffer, taking its source control archive with it"
  449.   (interactive "FNew name: ")
  450.   (if (and (buffer-modified-p)
  451.        (y-or-n-p (format "%s has been modified. Write it out? "
  452.                  (buffer-name))))
  453.       (save-buffer))
  454.   (sc-rename-file buffer-file-name new)
  455.   (let ((old-buffer (current-buffer))
  456.     (new-buffer (find-file-noselect new)))
  457.     (set-window-buffer (selected-window) new-buffer)
  458.     (pop-to-buffer (current-buffer))
  459.     (bury-buffer old-buffer)))
  460.  
  461.  
  462. ;;; Mode independent functions 
  463. ;;; All those sc-... functions FUNCALL the corresponding sc-generic-... function.  
  464. ;;; The variables are set to functions that do the SCCS, RCS or CVS commands 
  465. ;;; depending on the mode chosen.
  466.  
  467. (defvar sc-generic-lock-info ()
  468.   "Function to implement sc-lock-info")
  469.  
  470. (defun sc-lock-info (file)
  471.   "Return a list of the current locker and current locked revision for FILE.
  472. Returns NIL if FILE is not registered in the source control system.
  473. Return (NIL NIL) if FILE is registered but not locked.
  474. Return (locker revision) if file is locked."
  475.   (funcall sc-generic-lock-info file))
  476.  
  477.  
  478. (defvar sc-generic-register ()
  479.   "Function to implement sc-register")
  480.  
  481. (defun sc-register (file revision)
  482.   "Register FILE under source control with initial revision REVISION."
  483.   (funcall sc-generic-register file revision))
  484.  
  485.  
  486. (defvar sc-generic-check-out ()
  487.   "Function to implement sc-check-out")
  488.  
  489. (defun sc-check-out (file lockp)
  490.   "Checks out the latest version of FILE.  
  491. If LOCKP is not NIL, FILE is also locked."
  492.   (funcall sc-generic-check-out file lockp))
  493.  
  494.  
  495. (defvar sc-generic-get-version ()
  496.   "Function to implement sc-get-version")
  497.  
  498. (defun sc-get-version (file buffer revision)
  499.   "Insert a previous revison of FILE in BUFFER.  
  500. REVISION is the revision number requested."
  501.   (funcall sc-generic-get-version file buffer revision))
  502.  
  503.  
  504. (defvar sc-generic-check-in ()
  505.   "Function to implement sc-check-in")
  506.  
  507. (defun sc-check-in (file revision message)
  508.   "Check in FILE with revision REVISION.
  509. MESSAGE is a string describing the changes."
  510.   (funcall sc-generic-check-in file revision message))
  511.  
  512.  
  513. (defvar sc-generic-history ()
  514.   "Function to implement sc-history")
  515.  
  516. (defun sc-history (file)
  517.   "Insert the edit history of FILE in the current buffer."
  518.   (funcall sc-generic-history file))
  519.  
  520.  
  521. (defvar sc-generic-tree-list ()
  522.   "Function to implement sc-tree-list")
  523.  
  524. (defun sc-tree-list ()
  525.   "List in the current buffer the files registered in the source control system"
  526.   (funcall sc-generic-tree-list))
  527.   
  528.  
  529. (defvar sc-generic-new-revision-p ()
  530.   "Function to implement sc-new-revision-p")
  531.  
  532. (defun sc-new-revision-p (file)
  533.   "True if a new revision of FILE was checked in since we last got a copy of it"
  534.   (funcall sc-generic-new-revision-p file))
  535.  
  536.  
  537. (defvar sc-generic-revert ()
  538.   "Function to implement sc-revert")
  539.  
  540. (defun sc-revert (file)
  541.   "Cancel a check out of FILE and get back the latest checked in version"
  542.   (funcall sc-generic-revert file))
  543.  
  544.  
  545. (defvar sc-generic-rename ()
  546.   "Function to implement sc-rename")
  547.  
  548. (defun sc-rename (old new)
  549.   "Rename the source control archives for OLD to NEW"
  550.   (funcall sc-generic-rename old new))
  551.  
  552.  
  553. (defvar sc-menu ()
  554.   "Menu to use")
  555.   
  556.  
  557. ;;; Utilities functions
  558. (defun sc-do-command (buffer message command file sc-file &rest flags)
  559.   "Execute a command, notifying the user and checking for errors."
  560.   (setq file (expand-file-name file))
  561.   (message "Running %s on %s..." message file)
  562.   (let ((status
  563.      (save-excursion
  564.        (set-buffer (get-buffer-create buffer))
  565.        (erase-buffer)
  566.        (setq flags (append flags (and file (list sc-file))))
  567.        (setq flags (delq () flags))
  568.        (let ((default-directory (file-name-directory (or file "./"))))
  569.          (eq (apply 'call-process command nil t nil flags) 0)))))
  570.     (if status
  571.     (message "Running %s...OK" message)
  572.       (save-excursion
  573.     (set-buffer buffer)
  574.     (goto-char (point-min))
  575.     (insert command)
  576.     (mapcar '(lambda (i) (insert " " i)) flags)
  577.     (insert "\n\n")
  578.     (goto-char (point-min)))
  579.       (display-buffer buffer)
  580.       (error "Running %s...FAILED" message))))
  581.  
  582. (defun sc-enter-comment ()
  583.   "Enter a comment. Return it as a string."
  584.   (let ((buffer (sc-temp-buffer)))
  585.     (setq sc-generic-log-buf
  586.       (get-buffer-create (format "*%s-Log*" sc-generic-name)))
  587.     (save-window-excursion
  588.       ;; this excursion returns t if the new version was saved OK
  589.       (pop-to-buffer buffer)
  590.       (erase-buffer)
  591.       (set-buffer-modified-p nil)
  592.       (sc-log-entry-mode)
  593.       (message 
  594.        "Enter log message. Type C-c C-c when done, C-c ? for help.")
  595.       (prog1
  596.       (and (not (error-occurred (recursive-edit)))
  597.            (let ((bs (buffer-string)))
  598.          (if (> (length bs) 0) bs)))
  599.     (setq buffer-file-name nil)
  600.     (bury-buffer buffer)))))
  601.  
  602. (defun sc-locking-user (file)
  603.   "Return the login name of the locker of FILE.  Return nil if FILE is not locked"
  604.   (car (sc-lock-info file)))
  605.  
  606. (defun sc-locked-revision (file)
  607.   "Return the revision number currently locked for FILE, nil if FILE is not locked."
  608.   (car (cdr (sc-lock-info file))))
  609.  
  610. (defun sc-mode-line ()
  611.   "Set the mode line for the current buffer.
  612. FILE is the file being visited."
  613.   (let* ((file buffer-file-name)
  614.      (lock-info (sc-lock-info file)))
  615.     ;; ensure that the global mode string is not NIL
  616.     (or global-mode-string (setq global-mode-string '("")))
  617.     ;; ensure that our variable is in the global-mode-string
  618.     (or (memq 'sc-mode-line-string global-mode-string)
  619.     (setq global-mode-string
  620.           (append global-mode-string '(sc-mode-line-string))))
  621.     (make-local-variable 'sc-mode-line-string)
  622.     (setq sc-mode-line-string
  623.       (cond ((or
  624.           (eq lock-info 'na)
  625.           (null lock-info))     ())
  626.         ((null (car lock-info))
  627.          (format " <%s:>" sc-generic-name))
  628.         ((equal (car lock-info) (user-login-name))
  629.          (format " <%s: %s>" sc-generic-name (car (cdr lock-info))))
  630.         (t
  631.          (format " <%s: %s>" sc-generic-name (car lock-info)))))))
  632.  
  633. (defun sc-temp-buffer ()
  634.   "Return a temporary buffer to use for output"
  635.   (get-buffer-create (format "*%s*" sc-generic-name)))
  636.  
  637. (defun sc-tree-walk (func &rest args)
  638.   "Apply FUNC to the files registered in the source control system.
  639. FUNC is passed the file path and ARGS."
  640.   (let* ((buffer-name (format "*%s directory*" sc-generic-name))
  641.      (buffer (get-buffer-create buffer-name))
  642.      (dir default-directory)
  643.      files)
  644.     ;; recreate the directory buffer in the right directory
  645.     (save-excursion
  646.       (set-buffer buffer)
  647.       (erase-buffer)
  648.       (setq default-directory dir)
  649.       ;; get a list of all the registered files
  650.       (sc-tree-list)
  651.       ;; remove the "not found" messages
  652.       (goto-char (point-min))
  653.       (while (search-forward "not found" () t)
  654.     (beginning-of-line 1)
  655.     (kill-line 1))
  656.       ;; check if any file is listed
  657.       (if (= (point-min) (point-max))
  658.       (error "No registered files under %s" default-directory))
  659.       ;; build the list of files
  660.       (goto-char (point-min))
  661.       (setq files ())
  662.       (while (not (eobp))
  663.     (let ((file
  664.            (buffer-substring (point) (progn (end-of-line) (point)))))
  665.       (setq files (cons file files)))
  666.     (forward-line 1))
  667.       (setq files (nreverse files))
  668.       ;; let the function output information in the buffer
  669.       (erase-buffer))
  670.     (display-buffer buffer)
  671.     ;; apply the function
  672.     (save-excursion
  673.       (set-buffer buffer)
  674.       (while files
  675.     (apply func (car files) args)
  676.     (setq files (cdr files)))
  677.       buffer)))
  678.   
  679. (defun sc-get-version-in-temp-file (file revision)
  680.   "For the given FILE, retrieve a copy of the version with given REVISION.
  681. The text is retrieved into a tempfile.  Return the tempfile name."
  682.   (let* ((oldversion
  683.       (make-temp-name
  684.        (concat (or (ccase-protect-expanded-name revision) "current")
  685.            "-"
  686.            (file-name-nondirectory file)
  687.            "-")))
  688.      (vbuf (get-buffer-create oldversion)))
  689.     (sc-get-version file vbuf revision)
  690.     (save-excursion
  691.       (set-buffer vbuf)
  692.       (write-region (point-min) (point-max) oldversion t 0))
  693.     (kill-buffer vbuf)
  694.     (sc-chmod "-w" oldversion)
  695.     oldversion))
  696.  
  697. ;; Functions used to get directory level information
  698.  
  699. (defun sc-insert-file-lock-info (file lock-info)
  700.   (insert (car lock-info) ":" (car (cdr lock-info)))
  701.   (indent-to-column 16 1)
  702.   (insert (file-name-nondirectory file) "\n"))
  703.   
  704. (defun sc-list-file-if-locked (file &optional arg)
  705.    "List all files underneath the current directory matching a prefix type."
  706.    (let ((lock-info (sc-lock-info file)))
  707.      (if (and lock-info
  708.           (car lock-info)
  709.           (or (null arg) (equal arg (car lock-info))))
  710.      (progn
  711.        (sc-insert-file-lock-info file lock-info)
  712.        (sit-for 0)))))
  713.  
  714. (defun sc-list-file (file)
  715.   (let ((lock-info (sc-lock-info file)))
  716.     (cond ((eq lock-info 'na)
  717.        (indent-to-column 16 1)
  718.        (insert (file-name-nondirectory file) "\n"))
  719.       ((car lock-info)
  720.        (sc-insert-file-lock-info file lock-info))
  721.       ((sc-new-revision-p file)
  722.        (insert "needs update")
  723.        (indent-to-column 16 1)
  724.        (insert (file-name-nondirectory file) "\n"))
  725.       (t
  726.        (indent-to-column 16 1)
  727.        (insert (file-name-nondirectory file) "\n")))
  728.     (sit-for 0)))
  729.  
  730. ;;; Function to update one file from the archive
  731. (defun sc-update-file (file)
  732.   "get the latest version of the file if a new one was checked-in"
  733.   (if (sc-new-revision-p file)
  734.       (let ((file-name (file-name-nondirectory file)))
  735.     ;; get the latest copy
  736.     (rename-file (sc-get-version-in-temp-file file nil) file t)
  737.     (let ((b (get-file-buffer file)))
  738.       (if b
  739.           (save-excursion
  740.         (set-buffer b)
  741.         (revert-buffer nil t)
  742.         (sc-mode-line))))
  743.     ;; show the file was updated
  744.     (insert "updated")
  745.     (indent-to-column 16 1)
  746.     (insert file-name "\n")
  747.     (sit-for 0))))
  748.  
  749. ;; Set up key bindings for use while editing log messages
  750.  
  751. (if sc-log-entry-keymap
  752.     nil
  753.   (setq sc-log-entry-keymap (make-sparse-keymap))
  754.   (define-key sc-log-entry-keymap "\C-ci" 'sc-insert-last-log)
  755.   (define-key sc-log-entry-keymap "\C-c\C-i" 'sc-insert-last-log)
  756.   (define-key sc-log-entry-keymap "\C-ca" 'sc-abort-check-in)
  757.   (define-key sc-log-entry-keymap "\C-c\C-a" 'sc-abort-check-in)
  758.   (define-key sc-log-entry-keymap "\C-c\C-c" 'sc-log-exit)
  759.   (define-key sc-log-entry-keymap "\C-x\C-s" 'sc-log-exit))
  760.  
  761. (defvar sc-mode-hook nil
  762.   "*Function or functions to run on entry to sc-mode.")
  763.  
  764. (defvar sc-mode ()
  765.   "The currently active source control mode.  Use M-x sc-mode to set it")
  766.  
  767. ;;;###autoload
  768. (defun sc-mode (system)
  769.   "Toggle sc-mode.
  770. SYSTEM can be sccs, rcs or cvs.
  771. Cvs requires the pcl-cvs package.
  772.  
  773. The following commands are available
  774. \\[sc-next-operation]    perform next logical source control operation on current file
  775. \\[sc-show-changes]    compare the version being edited with an older one
  776. \\[sc-version-diff-file]    compare two older versions of a file
  777. \\[sc-show-history]        display change history of current file
  778. \\[sc-visit-previous-revision]    display an older revision of current file
  779. \\[sc-revert-file]        revert buffer to last checked-in version
  780. \\[sc-list-all-locked-files]        show all files locked in current directory
  781. \\[sc-list-locked-files]        show all files locked by you in current directory
  782. \\[sc-list-registered-files]        show all files under source control in current directory
  783. \\[sc-update-directory]        get fresh copies of files checked-in by others in current directory
  784. \\[sc-rename-file]        rename the current file and its source control file
  785.  
  786.  
  787. While you are entering a change log message for a check in, sc-log-entry-mode
  788. will be in effect.
  789.  
  790. Global user options:
  791.     sc-diff-command    A list consisting of the command and flags
  792.             to be used for generating context diffs.
  793.     sc-mode-expert    suppresses some conformation prompts,
  794.             notably for delta aborts and file saves.
  795.     sc-max-log-size    specifies the maximum allowable size
  796.             of a log message plus one.
  797.  
  798.  
  799. When using SCCS you have additional commands and options
  800.  
  801. \\[sccs-insert-headers]        insert source control headers in current file
  802.  
  803. When you generate headers into a buffer using \\[sccs-insert-headers],
  804. the value of sc-insert-headers-hook is called before insertion. If the
  805. file is recognized a C or Lisp source, sc-insert-c-header-hook or
  806. sc-insert-lisp-header-hook is called after insertion respectively.
  807.  
  808.     sccs-headers-wanted    which %-keywords to insert when adding
  809.             headers with C-c h
  810.     sccs-insert-static    if non-nil, keywords inserted in C files
  811.             get stuffed in a static string area so that
  812.             what(1) can see them in the compiled object code.
  813.  
  814. When using CVS you have additional commands
  815.  
  816. \\[sc-cvs-update-directory]    update the current directory using pcl-cvs
  817. \\[sc-cvs-file-status]        show the CVS status of current file
  818. "
  819.   (interactive
  820.    (if sc-mode
  821.        '(())
  822.      (list
  823.       (intern
  824.     (read-string "Turn on source control mode on for: " "SCCS")))))
  825.   (cond ((eq system ())
  826.      (remove-hook 'find-file-hooks 'sc-mode-line)
  827.      (delete-menu-item (list sc-generic-name))
  828.      (remove-hook 'activate-menubar-hook 'sc-sensitize-menu)
  829.      (setq sc-mode ()))
  830.     (sc-mode
  831.      (sc-mode ())
  832.      (sc-mode system))
  833.     (t
  834.      (setq system (intern (upcase (symbol-name system))))
  835.      (let ((f (intern (format "sc-set-%s-mode" system))))
  836.        (if (not (fboundp f))
  837.            (error
  838.         "No source control interface for \"%s\".  \
  839. Please use SCCS, RCS, CVS, or Atria."
  840.         system)
  841.          (funcall f)
  842.          (add-hook 'find-file-hooks 'sc-mode-line)
  843.          (add-submenu '() (cons sc-generic-name sc-menu))
  844.          (add-hook 'activate-menubar-hook 'sc-sensitize-menu)
  845.          (run-hooks 'sc-mode-hook)
  846.          (setq sc-mode system))))))
  847.  
  848. (defun sc-log-entry-mode ()
  849.   "Major mode for editing log message.
  850.  
  851. These bindings are available when entering the log message
  852. \\[sc-log-exit]        proceed with check in, ending log message entry
  853. \\[sc-insert-last-log]        insert log message from last check-in
  854. \\[sc-abort-check-in]        abort this check-in
  855.  
  856. Entry to the change-log submode calls the value of text-mode-hook, then
  857. the value sc-log-entry-mode-hook.
  858. "
  859.   (interactive)
  860.   (set-syntax-table text-mode-syntax-table)
  861.   (use-local-map sc-log-entry-keymap)
  862.   (setq local-abbrev-table text-mode-abbrev-table)
  863.   (setq major-mode 'sc-log-entry-mode)
  864.   (setq mode-name "Source Control Change Log Entry")
  865.   (run-hooks 'text-mode-hook 'sc-log-entry-mode-hook))
  866.  
  867.  
  868.  
  869. ;;; SCCS specific part
  870.  
  871. ;; Find a reasonable default for the SCCS bin directory
  872. (defvar sccs-bin-directory
  873.   (cond ((file-executable-p "/usr/sccs/unget") "/usr/sccs")
  874.     ((file-executable-p "/usr/bin/unget") "/usr/bin")
  875.     ((file-directory-p "/usr/sccs") "/usr/sccs")
  876.     ((file-directory-p "/usr/bin/sccs") "/usr/bin/sccs")
  877.     (t "/usr/bin"))
  878.   "*Directory where to find the sccs executables")
  879.  
  880. (defvar sccs-headers-wanted '("\%\W\%")
  881.   "*SCCS header keywords to be inserted when sccs-insert-header is executed.")
  882.  
  883. (defvar sccs-insert-static t
  884.   "*Insert a static character string when inserting source control headers in C mode.
  885. Only relevant for the SCCS mode.")
  886.  
  887. ;; Vars the user doesn't need to know about.
  888.  
  889. (defvar sccs-log-entry-mode nil)
  890. (defvar sccs-current-major-version nil)
  891.  
  892. ;; Some helper functions
  893.  
  894. (defun sccs-name (file &optional letter)
  895.   "Return the sccs-file name corresponding to a given file."
  896.   (if (null file)
  897.       ()
  898.     (let ((expanded-file (expand-file-name file)))
  899.       (format "%sSCCS/%s.%s"
  900.           (concat (file-name-directory expanded-file))
  901.           (or letter "s")
  902.           (concat (file-name-nondirectory expanded-file))))))
  903.  
  904. (defun sccs-lock-info (file)
  905.   "Lock-info method for SCCS.  See sc-generic-lock-info"
  906.   (let ((sccs-file (sccs-name file "s"))
  907.     (lock-file (sccs-name file "p")))
  908.     (cond ((or (null file) (not (file-exists-p sccs-file)))
  909.        ())
  910.       ((not (file-exists-p lock-file))
  911.        (list () ()))
  912.       (t
  913.        (save-excursion
  914.          (set-buffer (get-buffer-create "*SCCS tmp*"))
  915.          (insert-file lock-file)
  916.          (while (search-forward " " () t)
  917.            (replace-match "\n" () t))
  918.          (goto-char (point-min))
  919.          (forward-line 1)
  920.          (let ((revision
  921.             (buffer-substring (point) (progn (end-of-line) (point))))
  922.            (name
  923.             (progn (forward-line 1)
  924.                (buffer-substring (point)
  925.                          (progn (end-of-line) (point))))))
  926.            (kill-buffer (current-buffer))
  927.            (list name revision)))))))
  928.  
  929.  
  930. (defun sccs-do-command (buffer command file &rest flags)
  931.   "Execute an SCCS command, notifying the user and checking for errors."
  932.   (let ((exec-path (cons sccs-bin-directory exec-path)))
  933.     (apply 'sc-do-command buffer command command file (sccs-name file) flags)))
  934.  
  935. (defun sccs-admin (file sid)
  936.   "Checks a file into sccs.
  937. FILE is the unmodified name of the file.  SID should be the base-level sid to
  938. check it in under."
  939.   ;; give a change to save the file if it's modified
  940.   (if (and (buffer-modified-p)
  941.        (y-or-n-p (format "%s has been modified. Write it out? "
  942.                  (buffer-name))))
  943.       (save-buffer))
  944.   (sccs-do-command "*SCCS*" "admin" file
  945.            (concat "-i" file) (concat "-r" sid))
  946.   (sc-chmod "-w" file)
  947.   ;; expand SCCS headers
  948.   (sccs-check-out file nil))
  949.  
  950. (defun sccs-register (file revision)
  951.   (sccs-load-vars)
  952.   (if (and (not (file-exists-p "SCCS"))
  953.        (y-or-n-p "Directory SCCS does not exist, create it?"))
  954.       (make-directory "SCCS"))
  955.   (sccs-admin file
  956.           (cond 
  957.            (revision revision)
  958.            ((error-occurred (load-file "SCCS/emacs-vars.el")) "1")
  959.            (t sccs-current-major-version))))
  960.  
  961. (defun sccs-check-out (file lockp)
  962.   "Retrieve a copy of the latest version of the given file."
  963.   (sccs-do-command "*SCCS*" "get" file (if lockp "-e")))
  964.  
  965. (defun sccs-get-version (file buffer revision)
  966.   (sccs-do-command buffer "get" file
  967.            (and revision (concat "-r" revision))
  968.            "-p" "-s"))
  969.  
  970. (defun sccs-check-in (file revision comment)
  971.   "Check-in a given version of the given file with the given comment."
  972.   (sccs-do-command "*SCCS*" "delta" file "-n"
  973.            (format "-r%s" revision)
  974.            (format "-y%s" comment))
  975.   (sc-chmod "-w" file)
  976.   ;; sccs-delta already turned off write-privileges on the
  977.   ;; file, let's not re-fetch it unless there's something
  978.   ;; in it that get would expand
  979.   (save-excursion
  980.     (let ((buffer (get-file-buffer file)))
  981.       (if buffer
  982.       (progn
  983.         (set-buffer buffer)
  984.         (sccs-check-out file nil))))))
  985.  
  986. (defun sccs-history (file)
  987.   (sccs-do-command (current-buffer) "prs" file))
  988.  
  989. ;; There has *got* to be a better way to do this...
  990.  
  991. (defun sccs-save-vars (sid)
  992.   (save-excursion
  993.     (find-file "SCCS/emacs-vars.el")
  994.     (erase-buffer)
  995.     (insert "(setq sccs-current-major-version \"" sid "\")")
  996.     (basic-save-buffer)))
  997.  
  998. (defun sccs-load-vars ()
  999.   (if (error-occurred (load-file "SCCS/emacs-vars.el"))
  1000.       (setq sccs-current-major-version "1")))
  1001.  
  1002. ;; SCCS header insertion code
  1003.  
  1004. (defun sccs-insert-headers ()
  1005.   "*Insert headers for use with the Source Code Control System.
  1006. Headers desired are inserted at the start of the buffer, and are pulled from 
  1007. the variable sccs-headers-wanted"
  1008.   (interactive)
  1009.   (save-excursion
  1010.     (save-restriction
  1011.       (widen)
  1012.       (if (or (not (sccs-check-headers))
  1013.           (y-or-n-p "SCCS headers already exist.  Insert another set?"))
  1014.       (progn
  1015.          (goto-char (point-min))
  1016.          (run-hooks 'sccs-insert-headers-hook)
  1017.          (cond ((eq major-mode 'c-mode) (sccs-insert-c-header))
  1018.            ((eq major-mode 'lisp-mode) (sccs-insert-lisp-header))
  1019.            ((eq major-mode 'emacs-lisp-mode) (sccs-insert-lisp-header))
  1020.            ((eq major-mode 'scheme-mode) (sccs-insert-lisp-header))
  1021.            ((eq major-mode 'nroff-mode) (sccs-insert-nroff-header))
  1022.            ((eq major-mode 'plain-tex-mode) (sccs-insert-tex-header))
  1023.            ((eq major-mode 'texinfo-mode) (sccs-insert-texinfo-header))
  1024.            (t (sccs-insert-generic-header))))))))
  1025.  
  1026.  
  1027.  
  1028. (defun sccs-insert-c-header ()
  1029.   (insert "/*\n")
  1030.   (mapcar '(lambda (s)
  1031.          (insert " *\t" s "\n"))
  1032.       sccs-headers-wanted)
  1033.   (insert " */\n\n")
  1034.   (if (and sccs-insert-static 
  1035.        (not (string-match "\\.h$" buffer-file-name)))
  1036.       (progn
  1037.     (insert "#ifndef lint\n"
  1038.         "static char *sccsid")
  1039. ;;    (setq st (point))
  1040. ;;    (insert (file-name-nondirectory buffer-file-name))
  1041. ;;    (setq en (point))
  1042. ;;    (subst-char-in-region st en ?. ?_)
  1043.     (insert " = \"\%\W\%\";\n"
  1044.         "#endif /* lint */\n\n")))
  1045.   (run-hooks 'sccs-insert-c-header-hook))
  1046.  
  1047. (defun sccs-insert-lisp-header ()
  1048.   (mapcar '(lambda (s) 
  1049.           (insert ";;;\t" s "\n"))
  1050.       sccs-headers-wanted)
  1051.   (insert "\n")
  1052.   (run-hooks 'sccs-insert-lisp-header-hook))
  1053.  
  1054. (defun sccs-insert-nroff-header ()
  1055.   (mapcar '(lambda (s) 
  1056.           (insert ".\\\"\t" s "\n"))
  1057.       sccs-headers-wanted)
  1058.   (insert "\n")
  1059.   (run-hooks 'sccs-insert-nroff-header-hook))
  1060.  
  1061. (defun sccs-insert-tex-header ()
  1062.   (mapcar '(lambda (s) 
  1063.           (insert "%%\t" s "\n"))
  1064.       sccs-headers-wanted)
  1065.   (insert "\n")
  1066.   (run-hooks 'sccs-insert-tex-header-hook))
  1067.  
  1068. (defun sccs-insert-texinfo-header ()
  1069.   (mapcar '(lambda (s) 
  1070.           (insert "@comment\t" s "\n"))
  1071.       sccs-headers-wanted)
  1072.   (insert "\n")
  1073.   (run-hooks 'sccs-insert-texinfo-header-hook))
  1074.  
  1075. (defun sccs-insert-generic-header ()
  1076.   (let* ((comment-start-sccs (or comment-start "#"))
  1077.      (comment-end-sccs (or comment-end ""))
  1078.      (dont-insert-nl-p (string-match "\n" comment-end-sccs)))
  1079.     (mapcar '(lambda (s)
  1080.            (insert comment-start-sccs "\t" s ""
  1081.                comment-end-sccs (if dont-insert-nl-p "" "\n")))
  1082.       sccs-headers-wanted)
  1083.   (insert comment-start-sccs comment-end-sccs (if dont-insert-nl-p "" "\n"))))
  1084.  
  1085. (defun sccs-check-headers ()
  1086.   "Check if the current file has any SCCS headers in it."
  1087.   (save-excursion
  1088.     (goto-char (point-min))
  1089.     (let ((case-fold-search ()))
  1090.       (re-search-forward  "%[MIRLBSDHTEGUYFPQCZWA]%" (point-max) t))))
  1091.  
  1092. (defun sccs-tree-list ()
  1093.   "List all the registered files in the current directory"
  1094.   (call-process "/bin/sh" () t () "-c"
  1095.         (concat "/bin/ls -1 " default-directory "SCCS/s.*"))
  1096.   (goto-char (point-min))
  1097.   (while (search-forward "SCCS/s." () t)
  1098.     (replace-match "" () t)))
  1099.  
  1100. (defun sccs-new-revision-p (file)
  1101.   "True if the SCCS archive is more recent than the file itself"
  1102.   (file-newer-than-file-p (sccs-name file) file))
  1103.  
  1104. (defun sccs-revert (file)
  1105.   "Cancel a check-out and get a fresh copy of the file"
  1106.   (delete-file (sccs-name file "p"))
  1107.   (delete-file file)
  1108.   (sccs-do-command "*SCCS*" "get" file "-s"))
  1109.  
  1110. (defun sccs-rename (old new)
  1111.   "Rename the SCCS archives for OLD to NEW"
  1112.   (if (file-exists-p (sccs-name old "p"))
  1113.       (rename-file (sccs-name old "p") (sccs-name new "p") t))
  1114.   (if (file-exists-p (sccs-name old "s"))
  1115.       (rename-file (sccs-name old "s") (sccs-name new "s") t)))
  1116.  
  1117.  
  1118. ;;; RCS specific part
  1119.  
  1120. ;; Some helper functions
  1121.  
  1122. (defun rcs-name (file)
  1123.   "Return the rcs-file corresponding to a given file."
  1124.   (if (null file)
  1125.       ()
  1126.     (let* ((name (expand-file-name file))
  1127.        (rcs-file (concat name ",v")))
  1128.       (if (and (not (file-exists-p rcs-file))
  1129.            (file-exists-p (concat (file-name-directory name) "RCS")))
  1130.       (setq rcs-file 
  1131.         (format "%sRCS/%s,v" (file-name-directory name)
  1132.             (file-name-nondirectory name))))
  1133.       rcs-file)))
  1134.  
  1135. (defun rcs-lock-info (file)
  1136.   "Lock-info method for RCS.  See sc-generic-lock-info"
  1137.   (let ((rcs-file (rcs-name file))
  1138.     locks-regexp)
  1139.     (if (or (null rcs-file) (not (file-exists-p rcs-file)))
  1140.     ()
  1141.       (save-excursion
  1142.     (set-buffer (get-buffer-create "*RCS tmp*"))
  1143.     (erase-buffer)
  1144.     (call-process "rlog" () t () "-L" "-h" rcs-file)
  1145.     (goto-char (point-min))
  1146.     (if (looking-at "\n.*Working file")
  1147.         ;; RCS 4.x
  1148.         (setq locks-regexp "^locks:")
  1149.       ;; RCS 5.x
  1150.       (setq locks-regexp "^locks:.*$\n"))
  1151.     (if (not (re-search-forward locks-regexp () t))
  1152.         (list () ())
  1153.       (if (not (looking-at (concat "[\t ]*\\([^:]*\\): \\([0-9\\.]*\\)")))
  1154.           (list () ())
  1155.         (list (buffer-substring (match-beginning 1) (match-end 1))
  1156.           (buffer-substring (match-beginning 2) (match-end 2)))))))))
  1157.  
  1158.  
  1159. (defun rcs-register (file revision)
  1160.   (if (and (not (file-exists-p "RCS"))
  1161.        (y-or-n-p "Directory RCS does not exist, create it?"))
  1162.       (make-directory "RCS"))
  1163.   (sc-do-command "*RCS*" "ci" "ci" file (rcs-name file) "-u"))
  1164.  
  1165. (defun rcs-check-out (file lockp)
  1166.   (sc-do-command "*RCS*" "co" "co" file (rcs-name file) (if lockp "-l")))
  1167.  
  1168. (defun rcs-get-version (file buffer revision)
  1169.   (sc-do-command buffer "co" "co" file (rcs-name file)
  1170.          (if revision (concat "-p" revision) "-p")
  1171.          "-q"))
  1172.  
  1173. (defun rcs-check-in (file revision comment)
  1174.   "Check-in a given version of the given file with the given comment."
  1175.   (sc-do-command "*RCS*" "ci" "ci" file (rcs-name file) "-f"
  1176.          (format "-m%s" comment)
  1177.          (if (equal revision (sc-locked-revision file))
  1178.              "-u"
  1179.            (format "-u%s" revision))))
  1180.  
  1181. (defun rcs-history (file)
  1182.   (sc-do-command (current-buffer) "rlog" "rlog" file (rcs-name file)))
  1183.  
  1184. (defun rcs-tree-list ()
  1185.   "List all the registered files in the current directory"
  1186.   (call-process "/bin/sh" () t () "-c"
  1187.         (concat "/bin/ls -1 " default-directory "RCS/*,v"))
  1188.   (call-process "/bin/sh" () t () "-c"
  1189.         (concat "/bin/ls -1 " default-directory "*,v"))
  1190.   (goto-char (point-min))
  1191.   (while (search-forward "RCS/" () t)
  1192.     (replace-match "" () t))
  1193.   (goto-char (point-min))
  1194.   (while (search-forward ",v" () t)
  1195.     (replace-match "" () t)))
  1196.  
  1197. (defun rcs-new-revision-p (file)
  1198.   "True if the archive is more recent than the file itself"
  1199.   (file-newer-than-file-p (rcs-name file) file))
  1200.  
  1201. (defun rcs-revert (file)
  1202.   "Cancel a check-out and get a fresh copy of the file"
  1203.   (sc-do-command "*RCS*" "rcs" "rcs" file (rcs-name file) "-u")
  1204.   (delete-file file)
  1205.   (sc-do-command "*RCS*" "co" "co" file (rcs-name file)))
  1206.  
  1207. (defun rcs-rename (old new)
  1208.   "Rename the archives for OLD to NEW"
  1209.   (if (file-exists-p (rcs-name old))
  1210.       (rename-file (rcs-name old) (rcs-name new) t)))
  1211.  
  1212.  
  1213. ;;; CVS specific part
  1214.  
  1215. ;;; As we rely on pcl-cvs for the directory level functions the menu is
  1216. ;;; much shorter in CVS mode
  1217.  
  1218.  
  1219. (defun cvs-lock-info (file)
  1220.   "Lock-info method for CVS, different from RCS and SCCS modes.
  1221. File are never locked in CVS."
  1222.   (list () ()))
  1223.  
  1224. (defun cvs-register (file revision)
  1225.   (sc-do-command "*CVS*" "cvs add" cvs-program file
  1226.          (file-name-nondirectory file)
  1227.          "add" "-mInitial revision"))
  1228.  
  1229. (defun cvs-check-out (file lockp)
  1230.   )
  1231.  
  1232. (defun cvs-get-version (file buffer revision)
  1233.   (sc-do-command buffer "cvs update" cvs-program file file "update" 
  1234.          (if revision (concat "-r" revision))
  1235.          "-p" "-q"))
  1236.  
  1237. (defun cvs-check-in (file revision comment)
  1238.   "Check-in a given version of the given file with the given comment."
  1239.   (sc-do-command "*CVS*" "cvs commit" cvs-program file file "commit"
  1240.          (and revision (format "-r%s" revision))
  1241.          (format "-m%s" comment)))
  1242.  
  1243. (defun cvs-history (file)
  1244.   (sc-do-command (current-buffer) "cvs log" cvs-program file file "log"))
  1245.  
  1246. (defun cvs-revert (file)
  1247.   "Cancel a check-out and get a fresh copy of the file"
  1248.   (delete-file file)
  1249.   (sc-do-command "*CVS*" "cvs update" cvs-program file file "update"))
  1250.  
  1251. (defun sc-cvs-update-directory ()
  1252.   "Update the current directory by calling cvs-update from pcl-cvs"
  1253.   (interactive)
  1254.   (cvs-update default-directory))
  1255.  
  1256. (defun sc-cvs-file-status ()
  1257.   "Show the CVS status of the current file"
  1258.   (interactive)
  1259.   (if (not buffer-file-name)
  1260.       (error "There is no file associated with buffer %s" (buffer-name)))
  1261.   (let ((file buffer-file-name))
  1262.     (sc-do-command "*CVS*" "cvs status" cvs-program file file "status" "-v"))
  1263.   (save-excursion
  1264.     (set-buffer "*CVS*")
  1265.     (goto-char (point-min)))
  1266.   (display-buffer "*CVS*"))
  1267.  
  1268.  
  1269. ;;; ClearCase specific part
  1270.  
  1271. (defun ccase-is-registered-3 (fod)
  1272.   (if (or (not fod)
  1273.       (not (file-readable-p fod)))
  1274.       'na
  1275.     (let ((dirs sc-ccase-mfs-prefixes)
  1276.       (f nil)
  1277.       (file (expand-file-name fod)))
  1278.       (while (and (null f) dirs)
  1279.     (if (string-match (car dirs) file)
  1280.         (setq f t)
  1281.       (setq dirs (cdr dirs))))
  1282.       (if (null f)
  1283.       'na
  1284.     (sc-do-command "*CCase*" "describe" "cleartool" fod fod "describe")
  1285.     (save-excursion
  1286.       (set-buffer "*CCase*")
  1287.       (let ((s (buffer-string)))
  1288.         (cond
  1289.          ((string-match "@@" s) t)
  1290.          ((string-match "^Unix" s) 'na)
  1291.          (t nil)
  1292.          )))))))
  1293.  
  1294. (defun ccase-is-registered (fod)
  1295.   (eq (ccase-is-registered-3 fod) t))
  1296.  
  1297. (defun ccase-lock-info (file)
  1298.   (let ((cc (ccase-is-registered-3 file))
  1299.     s)
  1300.     (if (eq cc 't)
  1301.     (progn
  1302.       (save-excursion
  1303.         (set-buffer "*CCase*")
  1304.         (setq s (buffer-string)))
  1305.       (if (string-match "@@[^\n]*CHECKEDOUT\" from \\([^ ]*\\)[^\n]*\n[^\n]* by \\([^(\n]*\\) (" s)
  1306.           (list
  1307.            (substring s (match-beginning 1) (match-end 1))
  1308.            (substring s (match-beginning 2) (match-end 2)))
  1309.         (list nil nil)))
  1310.       cc)))
  1311.  
  1312. (defun ccase-maybe-comment (tag)
  1313.   (if (memq tag sc-ccase-comment-on)
  1314.       (sc-enter-comment)))
  1315.  
  1316. (defun ccase-register (file revision)
  1317.   "Registers the file. We don't support the revision argument.
  1318. Also, we have to checkout the directory first."
  1319.   ;; probably need proper error handling to catch the 
  1320.   ;; cases where we co the directory, but don't get to
  1321.   ;; ci it back (want to uco in this case)
  1322.   (let ((dpath (file-name-directory file)))
  1323.     (if (not (ccase-is-registered dpath))
  1324.     (error "Cannot register file outside of VOB")
  1325.       (sc-do-command "*CCase*" "co - dir" "cleartool" dpath dpath "co")
  1326.       (sc-do-command "*CCase*" "register" "cleartool" file file "mkelem")
  1327.       (sc-do-command "*CCase*" "ci - dir" "cleartool" dpath dpath "ci"))))
  1328.  
  1329. (defun ccase-check-out (file lockp)
  1330.   "Checks out the latest version of FILE.  
  1331. If LOCKP is not NIL, FILE is also locked."
  1332.   (let ((comment (ccase-maybe-comment 'checkout)))
  1333.     (sc-do-command "*CCase*" "co" "cleartool" file file "co"
  1334.            (if comment "-c" "-nc")
  1335.            (if comment comment)
  1336.   ;; this locking does not correspond to what we actually want. It's a
  1337.   ;; hack from the days when this was SCCS-only
  1338.            (if (ccase-reserve-p) "-res" "-unr"))
  1339. ))
  1340.  
  1341. (defun ccase-reserve-p ()
  1342.   "Determine whether the user wants a reserved or unreserved checkout"
  1343.   (cond
  1344.    ((eq sc-ccase-reserve t)   t)
  1345.    ((eq sc-ccase-reserve nil) nil)
  1346.    (t (y-or-n-p "Reserve Checkout? "))))
  1347.    
  1348. (defun ccase-get-version (file buffer revision)
  1349.   "Insert a previous revison of FILE in BUFFER.  
  1350. REVISION is the revision number requested."
  1351.   (save-excursion
  1352.     (set-buffer buffer)
  1353.     (delete-region (point-min) (point-max))
  1354.     (insert-file-contents (concat file "@@/" revision)))
  1355. )
  1356.  
  1357. (defun ccase-check-in (file revision message)
  1358.   "Check in FILE with revision REVISION.
  1359. MESSAGE is a string describing the changes."
  1360.   ;; we ignore revision since we can't use it
  1361.   (sc-do-command "*CCase*" "ci" "cleartool" file file "ci" "-c" message (if sc-mode-expert "-ide"))
  1362. )
  1363.  
  1364. (defun ccase-history (file)
  1365.   "Insert the edit history of FILE in the current buffer."
  1366.   (sc-do-command (buffer-name) "history" "cleartool" file file "lsh")
  1367. )
  1368.  
  1369. (defun ccase-tree-list ()
  1370.   "List in the current buffer the files registered in the source control system"
  1371.   ;;; This isn't going to fly as a practicality. We abstract everything out.
  1372.   ;;  (sc-do-command (buffer-name) "listing" "cleartool" (default-directory) (default-directory) "ls" "-r" "-short" "-vis" "-nxname")
  1373. )
  1374.   
  1375. (defun ccase-new-revision-p (file)
  1376.   "True if a new revision of FILE was checked in since we last got a copy of it"
  1377.   (save-excursion
  1378.   (let (newfile res br1 br2)
  1379.     (sc-do-command "*CCase*" "Describe" "cleartool" file file "des")
  1380.     (set-buffer "*CCase*")
  1381.     (goto-char (point-min))
  1382.     (if (setq pos (search-forward-regexp "@@\\([^ \"]*\\)CHECKEDOUT\" from \\([^ ]*\\) (\\([a-z]*\\))" nil t))
  1383. ;;    (if (setq pos (search-forward-regexp "@@\\([^ \"]*\\)CHECKEDOUT\"" nil t))
  1384.     (progn
  1385.       (setq res (buffer-substring (match-beginning 3) (match-end 3)))
  1386.       (if (equal res "unreserved")
  1387.           (progn
  1388.         (setq newfile (concat file "@@"
  1389.                       (buffer-substring (match-beginning 1)
  1390.                             (match-end 1))
  1391.                       "LATEST"))
  1392.         (setq br1 (buffer-substring (match-beginning 2) (match-end 2)))
  1393.         (sc-do-command "*CCase*" "Describe" "cleartool" file newfile
  1394.                    "des")
  1395.         (search-forward-regexp "@@\\([^ \"]*\\)" nil t)
  1396.         (setq br2 (buffer-substring (match-beginning 1) (match-end 1)))
  1397.         (not (equal br1 br2)))
  1398.         nil))
  1399.       (error "%s not currently checked out" file)))))
  1400.  
  1401. (defun ccase-revert (file)
  1402.   "Cancel a check out of FILE and get back the latest checked in version"
  1403.   (sc-do-command "*CCase*" "uco" "cleartool" file file "unco")
  1404. )
  1405.  
  1406. (defun ccase-rename (old new)
  1407.   "Rename the source control archives for OLD to NEW"
  1408.   (let ((dpath (file-name-directory old))
  1409.     (comment (ccase-maybe-comment 'rename)))
  1410.     (if (not (ccase-is-registered dpath))
  1411.     (error "Cannot rename file outside of VOB")
  1412.       (sc-do-command "*CCase*" "co - dir" "cleartool" dpath dpath "co"
  1413.            (if comment "-c" "-nc")
  1414.            (if comment comment))
  1415.       (sc-do-command "*CCase*" "mv" "cleartool" new new "mv" 
  1416.            (if comment "-c" "-nc")
  1417.            (if comment comment)
  1418.            old)
  1419.       (sc-do-command "*CCase*" "ci - dir" "cleartool" dpath dpath "ci" 
  1420.              (if comment "-c" "-nc")
  1421.              (if comment comment)))))
  1422.  
  1423. (defun sc-ccase-checkout-dir ()
  1424.   "Checkout the directory this file is in"
  1425.   (interactive)
  1426.   (let ((dpath default-directory)
  1427.     (comment (ccase-maybe-comment 'checkout-dir)))
  1428.     (if (not (ccase-is-registered dpath))
  1429.     (error "Cannot checkout directory outside of VOB")
  1430.       (sc-do-command "*CCase*" "co - dir" "cleartool" dpath dpath "co"
  1431.            (if comment "-c" "-nc")
  1432.            (if comment comment)))))
  1433.  
  1434. (defun sc-ccase-checkin-dir ()
  1435.   "Checkin the directory this file is in"
  1436.   (interactive)
  1437.   (let ((dpath default-directory)
  1438.     (comment (ccase-maybe-comment 'checkin-dir)))
  1439.     (if (not (ccase-is-registered dpath))
  1440.     (error "Cannot checkout directory outside of VOB")
  1441.       (sc-do-command "*CCase*" "ci - dir" "cleartool" dpath dpath "ci"
  1442.            (if comment "-c" "-nc")
  1443.            (if comment comment)))))
  1444.  
  1445. (defun sc-ccase-editcs ()
  1446.   "Edit Config Spec for this view"
  1447.   (interactive)
  1448.   (sc-do-command "*CCase-cs*" "catcs" "cleartool" "" nil "catcs")
  1449.   (switch-to-buffer-other-window "*CCase-cs*")
  1450.   (local-set-key "\C-c\C-c" 'exit-recursive-edit)
  1451.   (recursive-edit)
  1452.   (set-buffer "*CCase-cs*")
  1453.   (let ((name (make-temp-name "/tmp/configspec")))
  1454.     (write-region (point-min) (point-max) name)
  1455.     (kill-buffer "*CCase-cs*")
  1456.     (sc-do-command "*CCase*" "setcs" "cleartool" name name "setcs"))
  1457. )
  1458.  
  1459. (defun sc-ccase-new-brtype (brt)
  1460.   "Create a new branch type"
  1461.   (interactive "sBranch Name: ")
  1462.   (let ((comment (ccase-maybe-comment 'new-brtype)))
  1463.     (sc-do-command "*CCase*" "mkbrt" "cleartool" brt brt "mkbrtype"
  1464.            (if comment "-c" "-nc")
  1465.            (if comment comment))))
  1466.  
  1467. (defun sc-ccase-new-branch (brch)
  1468.   "Create a new branch for element"
  1469.   (interactive "sBranch: ")
  1470.   (let ((file (buffer-file-name))
  1471.     (comment (ccase-maybe-comment 'new-branch)))
  1472.     (sc-do-command "*CCase*" "mkbrch" "cleartool" file file "mkbranch" 
  1473.            (if comment "-c" "-nc")
  1474.            (if comment comment)
  1475.            brch)))
  1476.  
  1477. (defun sc-ccase-checkin-merge ()
  1478.   "Merge in changes to enable checkin"
  1479.   (interactive)
  1480.   (save-excursion
  1481.   (let ((file (buffer-file-name))
  1482.     (buf (current-buffer))
  1483.     (comment (ccase-maybe-comment 'checkin-merge)))
  1484.     (sc-do-command "*CCase*" "Describe" "cleartool" file file "des")
  1485.     (set-buffer "*CCase*")
  1486.     (goto-char (point-min))
  1487.     (if (search-forward-regexp "@@\\([^ \"]*\\)CHECKEDOUT\" from \\([^ ]*\\) (\\([a-z]*\\))" nil t)
  1488.     (progn
  1489.       (sc-do-command "*CCase*" "Merging" "cleartool" file
  1490.              (concat (buffer-substring (match-beginning 1)
  1491.                            (match-end 1)) "LATEST")
  1492.              "merge"
  1493.              (if comment "-c" "-nc")
  1494.              (if comment comment)
  1495.              "-abort" "-to" file "-ver")
  1496.       (set-buffer buf)
  1497.       (revert-buffer t t)
  1498.       (display-buffer "*CCase*"))
  1499.       (error "File %s not checked out" file)))))
  1500.       
  1501. (defun sc-ccase-version-tree ()
  1502.   "List version tree for file"
  1503.   (interactive)
  1504.   (let ((p (buffer-file-name)))
  1505.     (sc-do-command "*CCase*" "lsvtree" "cleartool" p p "lsvtree")
  1506.     (display-buffer "*CCase*")))
  1507.  
  1508. (defun ccase-protect-expanded-name (revision)
  1509.   "Protect ccase extended names from being used as temp names. Munge /s into :s"
  1510.   (if (equal sc-generic-name "CCase")
  1511.       (progn
  1512.     (if (string-match "/" revision)
  1513.         (let ((str (substring revision 0)) ;; copy string
  1514.           i)
  1515.           (while (setq i (string-match "/" str))
  1516.         (aset str i 58)) ; 58 is for :
  1517.           str)))))
  1518.  
  1519. (defun sc-ccase-list-locked-files ()
  1520.   (interactive)
  1521.   (sc-do-command "*CCase directory*" "listing" "cleartool" (default-directory) nil "lsco" "-cview"))
  1522.  
  1523. (defun sc-ccase-list-all-locked-files ()
  1524.   (interactive)
  1525.   (sc-do-command "*CCase directory*" "listing" "cleartool" (default-directory) nil "lsco"))
  1526.  
  1527. (defun sc-ccase-list-registered-files ()
  1528.   "List files registered in clearcase"
  1529.   (interactive)
  1530.   (sc-do-command "*CCase directory*" "listing" "cleartool" (default-directory) nil "ls" "-r" "-vis" "-nxname"))
  1531.  
  1532. ;;; Instantiation and installation of the menus
  1533.  
  1534. ;;; Set the menubar for Lucid Emacs
  1535. (defvar sc-default-menu
  1536.   '(["NEXT-OPERATION"    sc-next-operation    t    nil]
  1537.     ["Update Current Directory"        sc-update-directory    t]
  1538.     "----"
  1539.     ["Revert File"        sc-revert-file    t    nil]
  1540.     ["Rename File"        sc-rename-this-file        t    nil]
  1541.     "----"
  1542.     ["Show Changes"        sc-show-changes        t]
  1543.     ["Show Changes Since Revision..."    sc-show-revision-changes    t]
  1544.     ["Visit Previous Revision..."    sc-visit-previous-revision    t]
  1545.     ["Show Edit History"        sc-show-history        t]
  1546.     "----"
  1547.     ["List Locked Files"    sc-list-locked-files    t]
  1548.     ["List Locked Files Any User"    sc-list-all-locked-files    t]
  1549.     ["List Registered Files"    sc-list-registered-files    t])
  1550.   "Menubar entry for using the revision control system.")
  1551.  
  1552. (defvar sc-cvs-menu
  1553.   '(["Update Current Directory"        sc-cvs-update-directory    t]
  1554.     ["Revert File"        sc-revert-file    t    nil]
  1555.     "----"
  1556.     ["Show Changes"        sc-show-changes        t]
  1557.     ["Show Changes Since Revision..."    sc-show-revision-changes    t]
  1558.     ["Visit Previous Revision..."    sc-visit-previous-revision    t]
  1559.     ["Show File Status"        sc-cvs-file-status        t]
  1560.     ["Show Edit History"        sc-show-history        t])
  1561.   "Menubar entry for using the revision control system with CVS.")
  1562.  
  1563. (defvar sc-ccase-menu
  1564.   '(["NEXT-OPERATION"            sc-next-operation        t nil]
  1565.     ["Revert File"            sc-revert-file            t nil]
  1566.     ["Checkin Merge"            sc-ccase-checkin-merge      t]
  1567.     "----"
  1568.     ["Show Changes"            sc-show-changes            t]
  1569.     ["Show Changes Since Revision..."    sc-show-revision-changes    t]
  1570.     ["Visit Previous Revision..."    sc-visit-previous-revision    t]
  1571.     ["Show Edit History"        sc-show-history            t]
  1572.     "----"
  1573.     ("Directories" 
  1574.      ["Checkout Directory"        sc-ccase-checkout-dir        t]
  1575.      ["Checkin Directory"        sc-ccase-checkin-dir        t]
  1576.      ["Rename File..."            sc-rename-this-file        t nil])
  1577.     ("Configs"
  1578.      ["Edit Config Spec..."        sc-ccase-editcs            t]
  1579.      ["Create New Branch..."        sc-ccase-new-brtype        t]
  1580.      ["Make New Branch..."        sc-ccase-new-branch        t])
  1581.     ("Listings"
  1582.      ["List Version Tree"        sc-ccase-version-tree        t]
  1583.      ["List Locked Files"        sc-ccase-list-locked-files    t]
  1584.      ["List Locked Files Any User"    sc-ccase-list-all-locked-files    t]
  1585.      ["List Registered Files"        sc-ccase-list-registered-files    t]
  1586.      ))
  1587.   "Menubar entry for using the revision control system.")
  1588.  
  1589. (defun sc-sensitize-menu ()
  1590.   (let* ((rest (cdr (car
  1591.              (find-menu-item current-menubar (list sc-generic-name)))))
  1592.      (case-fold-search t)
  1593.      (file (if buffer-file-name
  1594.            (file-name-nondirectory buffer-file-name)
  1595.          (buffer-name)))
  1596.      (lock-info (sc-lock-info buffer-file-name))
  1597.      command
  1598.      nested-rest
  1599.      item)
  1600.     (while rest
  1601.       (setq item (car rest))
  1602.       (if (listp item)
  1603.       (progn
  1604.         (setq nested-rest (cons (cdr rest) nested-rest))
  1605.         (setq rest (cdr item)))
  1606.     (if (vectorp item)
  1607.         (progn
  1608.           (setq command (aref item 1))
  1609.           (cond ((eq 'sc-next-operation command)
  1610.              (aset item 0
  1611.                (cond ((eq lock-info 'na) "Not Available")
  1612.                  ((not lock-info) "Register File")
  1613.                  ((not (car lock-info)) "Check out File")
  1614.                  (t "Check in File")))
  1615.              ;; if locked by somebody else disable the next-operation
  1616.              (if (or (not buffer-file-name)
  1617.                  (eq lock-info 'na)
  1618.                  (and (car lock-info)
  1619.                   (not (equal sc-generic-name "CCase"))
  1620.                   (not (equal (car lock-info) (user-login-name)))))
  1621.              (aset item 2 ())
  1622.                (aset item 2 t)))
  1623.             ((eq lock-info 'na) (aset item 2 ()))
  1624.             ((> (length item) 3)
  1625.              (aset item 3 file))
  1626.             (t nil))
  1627.           (if (not (eq lock-info 'na))
  1628.           (let ((enable-file-items
  1629.              (if (member sc-generic-name '("CVS" "CCase"))
  1630.                  buffer-file-name
  1631.                (if lock-info t ()))))
  1632.             (if (memq command
  1633.                   '(sc-force-check-in-file
  1634.                 sc-register-file
  1635.                 sc-revert-file
  1636.                 sc-rename-this-file
  1637.                 sc-show-history
  1638.                 sc-show-changes
  1639.                 sc-show-revision-changes
  1640.                 sc-visit-previous-revision
  1641.                 sc-cvs-file-status
  1642.                 sc-ccase-checkout-dir
  1643.                 sc-ccase-checkin-dir
  1644.                 sc-ccase-editcs
  1645.                 sc-ccase-new-brtype
  1646.                 sc-ccase-new-branch
  1647.                 sc-ccase-checkin-merge
  1648.                 sc-ccase-needs-merge
  1649.                 sc-ccase-merge-changes
  1650.                 sc-ccase-create-label
  1651.                 sc-ccase-label-sources
  1652.                 sc-ccase-version-tree
  1653.                 sc-list-locked-files
  1654.                 sc-list-all-locked-files
  1655.                 sc-ccase-list-registered-files
  1656.                 ))
  1657.             (aset item 2 enable-file-items))))))
  1658.     (if (not (setq rest (cdr rest)))
  1659.         (if nested-rest
  1660.         (progn
  1661.           (setq rest (car nested-rest))
  1662.           (setq nested-rest (cdr nested-rest)))))))
  1663.     nil))
  1664.  
  1665.  
  1666. ;;; Function to decide which Source control to use
  1667. (defun sc-set-SCCS-mode ()
  1668.   (setq sc-generic-name "SCCS")
  1669.   (setq sc-can-hack-dir t)
  1670.   (setq sc-generic-lock-info 'sccs-lock-info)
  1671.   (setq sc-generic-register 'sccs-register)
  1672.   (setq sc-generic-check-out 'sccs-check-out)
  1673.   (setq sc-generic-get-version 'sccs-get-version)
  1674.   (setq sc-generic-check-in 'sccs-check-in)
  1675.   (setq sc-generic-history 'sccs-history)
  1676.   (setq sc-generic-tree-list 'sccs-tree-list)
  1677.   (setq sc-generic-new-revision-p 'sccs-new-revision-p)
  1678.   (setq sc-generic-revert 'sccs-revert)
  1679.   (setq sc-generic-rename 'sccs-rename)
  1680.   (setq sc-menu
  1681.     (cons (car sc-default-menu)
  1682.           (cons ["Insert Headers"    sccs-insert-headers    t]
  1683.             (cdr sc-default-menu))))
  1684.   (define-key sc-prefix-map "h" 'sccs-insert-headers)
  1685.   (define-key sc-prefix-map "\C-d" 'sc-update-directory))
  1686.  
  1687. (defun sc-set-RCS-mode ()
  1688.   (setq sc-generic-name "RCS")
  1689.   (setq sc-can-hack-dir t)
  1690.   (setq sc-generic-lock-info 'rcs-lock-info)
  1691.   (setq sc-generic-register 'rcs-register)
  1692.   (setq sc-generic-check-out 'rcs-check-out)
  1693.   (setq sc-generic-get-version 'rcs-get-version)
  1694.   (setq sc-generic-check-in 'rcs-check-in)
  1695.   (setq sc-generic-history 'rcs-history)
  1696.   (setq sc-generic-tree-list 'rcs-tree-list)
  1697.   (setq sc-generic-new-revision-p 'rcs-new-revision-p)
  1698.   (setq sc-generic-revert 'rcs-revert)
  1699.   (setq sc-generic-rename 'rcs-rename)
  1700.   (setq sc-menu sc-default-menu)
  1701.   (define-key sc-prefix-map "\C-d" 'sc-update-directory))
  1702.  
  1703. (defun sc-set-CVS-mode ()
  1704.   (require 'pcl-cvs)
  1705.   (setq sc-generic-name "CVS")
  1706.   (setq sc-can-hack-dir t)
  1707.   (setq sc-generic-lock-info 'cvs-lock-info)
  1708.   (setq sc-generic-register 'cvs-register)
  1709.   (setq sc-generic-check-out 'cvs-check-out)
  1710.   (setq sc-generic-get-version 'cvs-get-version)
  1711.   (setq sc-generic-check-in 'cvs-check-in)
  1712.   (setq sc-generic-history 'cvs-history)
  1713.   (setq sc-generic-tree-list 'cvs-tree-list)
  1714.   (setq sc-generic-new-revision-p 'cvs-new-revision-p)
  1715.   (setq sc-generic-revert 'cvs-revert)
  1716.   (setq sc-generic-rename 'cvs-rename)
  1717.   (setq sc-menu sc-cvs-menu)
  1718.   (define-key sc-prefix-map "\C-d" 'sc-cvs-update-directory)
  1719.   (define-key sc-prefix-map "s" 'sc-cvs-file-status))
  1720.  
  1721. (defun sc-set-CLEARCASE-mode ()
  1722.   (setq sc-generic-name "CCase")
  1723.   (setq sc-can-hack-dir nil)
  1724.   (setq sc-generic-lock-info 'ccase-lock-info)
  1725.   (setq sc-generic-register 'ccase-register)
  1726.   (setq sc-generic-check-out 'ccase-check-out)
  1727.   (setq sc-generic-get-version 'ccase-get-version)
  1728.   (setq sc-generic-check-in 'ccase-check-in)
  1729.   (setq sc-generic-history 'ccase-history)
  1730.   (setq sc-generic-tree-list 'ccase-tree-list)
  1731.   (setq sc-generic-new-revision-p 'ccase-new-revision-p)
  1732.   (setq sc-generic-revert 'ccase-revert)
  1733.   (setq sc-generic-rename 'ccase-rename)
  1734.   (setq sc-menu sc-ccase-menu)
  1735.  
  1736.   ;; caching for file directory types
  1737.   (save-excursion
  1738.     (set-buffer (get-buffer-create "*CCase*"))
  1739.     (shell-command-on-region (point-min) (point-max) "df -t mfs | sed -n 's%.*[       ]\\(/[^ ]*\\)$%\\1%p'" t)
  1740.     (goto-char (point-min))
  1741.     (let (x l)
  1742.       (while (condition-case nil (setq x (read (current-buffer)))
  1743.            (error nil))
  1744.     (setq l (cons (prin1-to-string x) l)))
  1745.       (setq sc-ccase-mfs-prefixes (nreverse l))))
  1746. )
  1747.  
  1748. (defun sc-set-ATRIA-mode ()
  1749.   (sc-set-CLEARCASE-mode))
  1750.  
  1751. (defun sc-set-CCASE-mode ()
  1752.   (sc-set-CLEARCASE-mode))
  1753.  
  1754.  
  1755. ;; the module is sucessfully loaded!
  1756. (provide 'generic-sc)
  1757.  
  1758. ;;; generic-sc.el ends here
  1759.